home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Source / Rtl / Win / FlatSB.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-22  |  5.3 KB  |  133 lines
  1. { *********************************************************************** }
  2. {                                                                         }
  3. { Delphi Runtime Library                                                  }
  4. {                                                                         }
  5. { Copyright (c) 1996-2001 Borland Software Corporation                    }
  6. {                                                                         }
  7. { *********************************************************************** }
  8.  
  9. {*******************************************************}
  10. {       Win32 flat scrollbar interface unit             }
  11. {*******************************************************}
  12.  
  13. unit FlatSB;
  14.  
  15. //{$WEAKPACKAGEUNIT}
  16.  
  17. interface
  18.  
  19. uses Windows;
  20.  
  21. function InitializeFlatSB(hWnd: HWND): Bool; stdcall;
  22. {$EXTERNALSYM InitializeFlatSB}
  23. procedure UninitializeFlatSB(hWnd: HWND); stdcall;
  24. {$EXTERNALSYM UninitializeFlatSB}
  25. function FlatSB_GetScrollProp(p1: HWND; propIndex: Integer;
  26.   p3: PInteger): Bool; stdcall;
  27. {$EXTERNALSYM FlatSB_GetScrollProp}
  28. function FlatSB_SetScrollProp(p1: HWND; index: Integer; newValue: Integer;
  29.   p4: Bool): Bool; stdcall;
  30. {$EXTERNALSYM FlatSB_SetScrollProp}
  31.  
  32. var
  33.   FlatSB_EnableScrollBar: function(hWnd: HWND; wSBflags, wArrows: UINT): BOOL; stdcall;
  34.   {$EXTERNALSYM FlatSB_EnableScrollBar}
  35.   FlatSB_ShowScrollBar: function(hWnd: HWND; wBar: Integer; bShow: BOOL): BOOL; stdcall;
  36.   {$EXTERNALSYM FlatSB_ShowScrollBar}
  37.   FlatSB_GetScrollRange: function(hWnd: HWND; nBar: Integer; var lpMinPos,
  38.     lpMaxPos: Integer): BOOL; stdcall;
  39.   {$EXTERNALSYM FlatSB_GetScrollRange}
  40.   FlatSB_GetScrollInfo: function(hWnd: HWND; BarFlag: Integer;
  41.     var ScrollInfo: TScrollInfo): BOOL; stdcall;
  42.   {$EXTERNALSYM FlatSB_GetScrollInfo}
  43.   FlatSB_GetScrollPos: function(hWnd: HWND; nBar: Integer): Integer; stdcall;
  44.   {$EXTERNALSYM FlatSB_GetScrollPos}
  45.   FlatSB_SetScrollPos: function(hWnd: HWND; nBar, nPos: Integer;
  46.     bRedraw: BOOL): Integer; stdcall;
  47.   {$EXTERNALSYM FlatSB_SetScrollPos}
  48.   FlatSB_SetScrollInfo: function(hWnd: HWND; BarFlag: Integer;
  49.     const ScrollInfo: TScrollInfo; Redraw: BOOL): Integer; stdcall;
  50.   {$EXTERNALSYM FlatSB_SetScrollInfo}
  51.   FlatSB_SetScrollRange: function(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer;
  52.     bRedraw: BOOL): BOOL; stdcall;
  53.   {$EXTERNALSYM FlatSB_SetScrollRange}
  54.  
  55. implementation
  56.  
  57. var
  58.   _FlatSB_GetScrollProp: function(p1: HWND; propIndex: Integer;
  59.     p3: PInteger): Bool; stdcall;
  60.   _FlatSB_SetScrollProp: function(p1: HWND; index: Integer; newValue: Integer;
  61.     p4: Bool): Bool; stdcall;
  62.   _InitializeFlatSB: function(hWnd: HWND): Bool; stdcall;
  63.   _UninitializeFlatSB: procedure(hWnd: HWND); stdcall;
  64.  
  65. function FlatSB_GetScrollProp(p1: HWND; propIndex: Integer;
  66.   p3: PInteger): Bool; stdcall;
  67. begin
  68.   Result := Assigned(_FlatSB_GetScrollProp) and
  69.     _FlatSB_GetScrollProp(p1, propIndex, p3);
  70. end;
  71.  
  72. function FlatSB_SetScrollProp(p1: HWND; index: Integer; newValue: Integer;
  73.   p4: Bool): Bool; stdcall;
  74. begin
  75.   Result := Assigned(_FlatSB_SetScrollProp) and
  76.     _FlatSB_SetScrollProp(p1, index, newValue, p4);
  77. end;
  78.  
  79. function InitializeFlatSB(hWnd: HWND): Bool; stdcall;
  80. begin
  81.   Result := Assigned(_InitializeFlatSB) and _InitializeFlatSB(hWnd);
  82. end;
  83.  
  84. procedure UninitializeFlatSB(hWnd: HWND); stdcall;
  85. begin
  86.   if Assigned(_UninitializeFlatSB) then _UninitializeFlatSB(hWnd);
  87. end;
  88.  
  89. procedure InitFlatSB;
  90. const
  91.   cctrl = 'comctl32.dll';
  92. var
  93.   ComCtl32DLL: THandle;
  94. begin
  95.   ComCtl32DLL := GetModuleHandle(cctrl);
  96.   if ComCtl32DLL <> 0 then
  97.   begin
  98.     @_InitializeFlatSB := GetProcAddress(ComCtl32DLL, 'InitializeFlatSB');
  99.     @_UninitializeFlatSB := GetProcAddress(ComCtl32DLL, 'UninitializeFlatSB');
  100.     @_FlatSB_GetScrollProp := GetProcAddress(ComCtl32DLL, 'FlatSB_GetScrollProp');
  101.     @_FlatSB_SetScrollProp := GetProcAddress(ComCtl32DLL, 'FlatSB_SetScrollProp');
  102.     @FlatSB_EnableScrollBar := GetProcAddress(ComCtl32DLL, 'FlatSB_EnableScrollBar');
  103.     if not Assigned(FlatSB_EnableScrollBar) then
  104.       @FlatSB_EnableScrollBar := @EnableScrollBar;
  105.     @FlatSB_ShowScrollBar := GetProcAddress(ComCtl32DLL, 'FlatSB_ShowScrollBar');
  106.     if not Assigned(FlatSB_ShowScrollBar) then
  107.       @FlatSB_ShowScrollBar := @ShowScrollBar;
  108.     @FlatSB_GetScrollRange := GetProcAddress(ComCtl32DLL, 'FlatSB_GetScrollRange');
  109.     if not Assigned(FlatSB_GetScrollRange) then
  110.       @FlatSB_GetScrollRange := @GetScrollRange;
  111.     @FlatSB_GetScrollInfo := GetProcAddress(ComCtl32DLL, 'FlatSB_GetScrollInfo');
  112.     if not Assigned(FlatSB_GetScrollInfo) then
  113.       @FlatSB_GetScrollInfo := @GetScrollInfo;
  114.     @FlatSB_GetScrollPos := GetProcAddress(ComCtl32DLL, 'FlatSB_GetScrollPos');
  115.     if not Assigned(FlatSB_GetScrollPos) then
  116.       @FlatSB_GetScrollPos := @GetScrollPos;
  117.     @FlatSB_SetScrollPos := GetProcAddress(ComCtl32DLL, 'FlatSB_SetScrollPos');
  118.     if not Assigned(FlatSB_SetScrollPos) then
  119.       @FlatSB_SetScrollPos := @SetScrollPos;
  120.     @FlatSB_SetScrollInfo := GetProcAddress(ComCtl32DLL, 'FlatSB_SetScrollInfo');
  121.     if not Assigned(FlatSB_SetScrollInfo) then
  122.       @FlatSB_SetScrollInfo := @SetScrollInfo;
  123.     @FlatSB_SetScrollRange := GetProcAddress(ComCtl32DLL, 'FlatSB_SetScrollRange');
  124.     if not Assigned(FlatSB_SetScrollRange) then
  125.       @FlatSB_SetScrollRange := @SetScrollRange;
  126.   end;
  127. end;
  128.  
  129. initialization
  130.   InitFlatSB;
  131.   
  132. end.
  133.